BMUG PD-ROM 1995 Fall/PD-ROM F95.toast/Utilities/FKeys/FKeys A-L/FreeRAM FKEY 1.3 ƒ/FreeRAM FKEY2.p

Text File | 1992-11-14 | 5.0 KB | 193 lines | [TEXT/ttxt]

{    FreeRAM FKEY © 1989-90 by Jon Wind                                                            }
{    Version 1.1 on 12/25/90                                                                            }
{    Version 1.2 on 9/20/92                                                                                }
{    Version 1.3 on 11/14/92                                                                            }

{    This FKEY displays the amount of Free RAM in the upper left of the menu bar.  Click            }
{    or press a key to restore menu bar.  If the Caps Lock key is down, the current heap            }
{    will be compacted and purge all purgeable blocks.  If executed on a machine running            }
{    in color, the current menu colors will be used to display the information.                        }

{     Thanks to Brad Pettit and his colorfkey for his method of conditional compilation.                }

{    To execute this as a program...                                                                        }
{        1. change the definition of fkey to false                                                        }
{        2. set the project type to application                                                            }
{        3. change the library from drvrruntime.lib to µruntime.lib                                    }
{        4. rebuild the project                                                                            }


{$setc fkey := true}

{$ifc fkey}

unit FreeRAMFKEY;

interface

    procedure main;

implementation

{$elsec}

    program FreeRAMFKEY;

{$endc}

        procedure main;
            const
                Vers = 'v1.3';
                bCommandKey = 48;
                bShiftKey = 63;
                bControlKey = 60;
                bOptionKey = 61;
                bCapsLockKey = 62;
                WaitTime = 45;
            type
                myScrapRec = record
                        kind: ResType;
                        offset: LongInt;
                    end;
                myScrapRecPtr = ^myScrapRec;
                myScrapRecHdl = ^myScrapRecPtr;
            var
                menuRect: Rect;
                savePort: GrafPtr;
                CMenuPtr: MCEntryPtr;
                usingColor: Boolean;
                p: grafport;
                theEvent: EventRecord;
                MemSize: LongInt;
                ScrapInfo: pScrapStuff;
                theErr: OSErr;
                thePtr: Ptr;
                theFont, baseLine, menuHeight: Integer;
                fInfo: FontInfo;


            function GetMBarHeight: Integer;
    { get current menu bar height }
                var
                    thePtr: ^Integer;
            begin
                thePtr := Pointer($BAA);
                GetMBarHeight := thePtr^;
            end;  { of func GetMBarHeight }

            function aNum2Str (aNum: LongInt): Str255;
    { NumToString procedure available as a function }
                var
                    NumStr: Str255;
            begin
                NumToString(aNum, NumStr);
                aNum2Str := NumStr;
            end;

            function GetKeyDown (index: Integer): Boolean;
    { return the state of the desired key - true if down; false if up }
                var
                    keys: keymap;
            begin
                GetKeys(keys);
                GetKeyDown := bittst(@keys, index);        { look at entry within the key map }
            end;

            function IsColor: Boolean;
    { return true if using 16 or more "colors" }
                var
                    maindevice: GDHandle;
                    theWorld: SysEnvRec;
            begin
                IsColor := False;
                if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call available? }
                    if theWorld.hasColorQD then        { has Color QuickDraw }
                        begin
                            maindevice := GetMainDevice;
                            IsColor := (maindevice^^.gdPMap^^.pixelsize > 2);        { 16 or more shades? }
                        end;
            end;{ of func IsColor }

 { --------- Main Procedure --------- }
        begin
            GetPort(savePort);            { save current grafport }

            usingColor := IsColor;
            if usingcolor then
                begin
                    OpenCPort(@p);            { open as current port }
                    CMenuPtr := GetMCEntry(0, 0);
                    if CMenuPtr <> nil then
                        begin
                            RGBForeColor(CMenuPtr^.mctRGB1);
                            RGBBackColor(CMenuPtr^.mctRGB4);
                        end;
                end
            else
                OpenPort(@p);                { open as current port }

            GetFNum('Geneva', theFont);
            TextFont(theFont);
            TextSize(9);
            GetFontInfo(fInfo);
            menuHeight := GetMBarHeight;
            baseLine := Pred(((menuHeight - (fInfo.ascent + fInfo.descent)) div 2) + fInfo.ascent);
            SetRect(menuRect, 1, 0, p.portrect.right, menuHeight - 1);
            EraseRoundRect(menuRect, 12, 12);

            MoveTo(menuRect.right - StringWidth(Vers) - 5, menuRect.bottom - 5);
            DrawString(Vers);

            TextFace([bold]);
            Moveto(35, baseLine);

            if GetKeyDown(bCapsLockKey) then        { test for caps lock down }
                begin
                    PurgeMem(maxSize);
                    MemSize := CompactMem(maxSize);
                end;

            DrawString(Concat(aNum2Str(FreeMem), ' bytes (', aNum2Str((FreeMem + 512) div 1024), 'K) free in current Heap'));
            TextFace([]);

            theErr := LoadScrap;
            ScrapInfo := InfoScrap;
            if ScrapInfo^.scrapSize > 0 then
                begin
                    HLock(ScrapInfo^.ScrapHandle);
                    thePtr := Pointer(Ord4(scrapinfo^.scraphandle^));
                    DrawString(Concat('; ', aNum2Str(ScrapInfo^.scrapSize), ' ['));
                    repeat
                        if Ord4(thePtr) <> Ord4(scrapinfo^.scraphandle^) then
                            DrawString(',');
                        DrawString(myScrapRecPtr(thePtr)^.kind);
                        if Odd(myScrapRecPtr(thePtr)^.offset) then
                            myScrapRecPtr(thePtr)^.offset := Succ(myScrapRecPtr(thePtr)^.offset);
                        thePtr := Pointer(Ord4(thePtr) + SizeOf(myScrapRec) + myScrapRecPtr(thePtr)^.offset);
                    until Ord4(thePtr) >= Ord4(ScrapInfo^.ScrapHandle^) + ScrapInfo^.scrapSize;
                    HUnLock(ScrapInfo^.ScrapHandle);
                    DrawString('] bytes in Scrap');
                end;

            if usingcolor then
                CloseCPort(@p)
            else
                ClosePort(@p);
            SetPort(savePort);            { restore grafport }

{•   Delay(WaitTime, Grow);            { delay to allow keys to be released •]}
            repeat
            until GetOSEvent(mDownMask + keyDownMask, theEvent);

            DrawMenuBar;                    { fix menubar }
        end;    { main }


{$ifc fkey = false}

    begin
        main;

{$endc}

    end.